home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
bipl.zip
/
PROCS.ZIP
/
ADLUTILS.ICN
< prev
next >
Wrap
Text File
|
1992-11-20
|
4KB
|
174 lines
############################################################################
#
# File: adlutils.icn
#
# Subject: Procedures to process address lists
#
# Author: Ralph E. Griswold
#
# Date: September 2, 1991
#
###########################################################################
#
# Procedures used by programs that process address lists:
#
# nextadd() get next address
# writeadd(add) write address
# get_country(add) get country
# get_state(add) get state (U.S. addresses only)
# get_city(add) get city (U.S. addresses only)
# get_zipcode(add) get ZIP code (U.S. addresses only)
# get_lastname(add) get last name
# get_namepfx(add) get name prefix
# get_title(add) get name title
# format_country(s) format country name
#
############################################################################
#
# Links: lastname, buffer, namepfx, title
#
############################################################################
link lastname, buffer, namepfx, title
record label(header, text, comments)
procedure nextadd()
local comments, header, line, text
initial { # Get to first label.
while line := Read() do
line ? {
if ="#" then {
PutBack(line)
break
}
}
}
header := Read() | fail
comments := text := ""
while line := Read() do
line ? {
if pos(0) then next # Skip empty lines.
else if ="*" then comments ||:= "\n" || line
else if ="#" then { # Header for next label.
PutBack(line)
break # Done with current label.
}
else text ||:= "\n" || line
}
every text | comments ?:= { # Strip off leading newline, if any.
move(1)
tab(0)
}
return label(header, text, comments)
end
procedure writeadd(add)
if *add.text + *add.comments = 0 then return
write(add.header)
if *add.text > 0 then write(add.text)
if *add.comments > 0 then write(add.comments)
return
end
procedure get_country(add)
trim(add.text) ? {
while tab(upto('\n')) do move(1)
if tab(0) ? {
tab(-1)
any(&digits)
} then return "U.S.A."
else return tab(0)
}
end
procedure get_state(add)
trim(add.text) ? {
while tab(upto('\n')) do move(1)
="APO"
while tab(upto(',')) do move(1)
tab(many(' '))
return (tab(any(&ucase)) || tab(any(&ucase))) | "XX"
}
end
procedure get_city(add) # only works for U.S. addresses
local result
result := ""
trim(add.text) ? {
while tab(upto('\n')) do move(1)
result := ="APO"
result ||:= tab(upto(','))
return result
}
end
procedure get_zipcode(add)
local zip
trim(add.text) ? {
while tab(upto('\n')) do move(1) # get to last line
while tab(upto(' ')) do tab(many(' ')) # get to last field
zip := tab(0)
if *zip = 5 & integer(zip) then return zip
else if *zip = 10 & zip ? {
integer(move(5)) & ="-" & integer(tab(0))
}
then return zip
else return "9999999999" # "to the end of the universe"
}
end
procedure get_lastname(add)
return lastname(add.text ? tab(upto('\n') | 0))
end
procedure get_namepfx(add)
return namepfx(add.text ? tab(upto('\n') | 0))
end
procedure get_title(add)
return title(add.text ? tab(upto('\n') | 0))
end
procedure format_country(s)
local t
s := map(s)
t := ""
s ? while tab(upto(&lcase)) do {
word := tab(many(&lcase))
if word == "of" then t ||:= word
else t ||:= {
word ? {
map(move(1),&lcase,&ucase) || tab(0)
}
}
t ||:= move(1)
}
return t
end